home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cocktail / puma.lha / puma / src / puma.scan < prev    next >
Text File  |  1992-09-25  |  8KB  |  323 lines
  1. /* Ich, Doktor Josef Grosch, Informatiker, 20.3.1989 */
  2.  
  3. EXPORT  {
  4. FROM StringMem    IMPORT tStringRef;
  5. FROM Idents    IMPORT tIdent    ;
  6. FROM Texts    IMPORT tText    ;
  7. FROM Positions    IMPORT tPosition;
  8.  
  9. INSERT tScanAttribute
  10.  
  11. PROCEDURE Error        (Text: ARRAY OF CHAR; Position: tPosition);
  12. PROCEDURE ErrorI    (Text: ARRAY OF CHAR; Position: tPosition; Ident: tIdent);
  13. PROCEDURE Warning    (Text: ARRAY OF CHAR; Position: tPosition);
  14. PROCEDURE WarningI    (Text: ARRAY OF CHAR; Position: tPosition; Ident: tIdent);
  15. }
  16.  
  17. GLOBAL  {
  18. FROM SYSTEM    IMPORT ADR;
  19. FROM StringMem    IMPORT PutString;
  20. FROM Strings    IMPORT tString, Concatenate, Char, SubString,
  21.             AssignEmpty, Length, WriteL;
  22. FROM Idents    IMPORT tIdent, MakeIdent, NoIdent, GetStringRef;
  23. FROM Texts    IMPORT MakeText, Append;
  24. FROM Sets    IMPORT IsElement;
  25. FROM Tree    IMPORT Options, ErrorCount;
  26. FROM Positions    IMPORT tPosition;
  27.  
  28. IMPORT Errors;
  29.  
  30. VAR NestingLevel: INTEGER; Position, StringPos: tPosition;
  31.  
  32. INSERT ErrorAttribute
  33.  
  34. PROCEDURE Error (Text: ARRAY OF CHAR; Position: tPosition);
  35.    BEGIN
  36.       Errors.Message (Text, Errors.Error, Position);
  37.       INC (ErrorCount);
  38.    END Error;
  39.  
  40. PROCEDURE ErrorI (Text: ARRAY OF CHAR; Position: tPosition; Ident: tIdent);
  41.    BEGIN
  42.       Errors.MessageI (Text, Errors.Error, Position, Errors.Ident, ADR (Ident));
  43.       INC (ErrorCount);
  44.    END ErrorI;
  45.  
  46. PROCEDURE Warning (Text: ARRAY OF CHAR; Position: tPosition);
  47.    BEGIN
  48.       IF NOT IsElement (ORD ('s'), Options) THEN
  49.      Errors.Message (Text, Errors.Warning, Position);
  50.       END;
  51.    END Warning;
  52.  
  53. PROCEDURE WarningI (Text: ARRAY OF CHAR; Position: tPosition; Ident: tIdent);
  54.    BEGIN
  55.       IF NOT IsElement (ORD ('s'), Options) THEN
  56.      Errors.MessageI (Text, Errors.Warning, Position, Errors.Ident, ADR (Ident));
  57.       END;
  58.    END WarningI;
  59. }
  60.  
  61. LOCAL    { VAR Word, String, TargetCode: tString; }
  62.  
  63. BEGIN    { NestingLevel := 0; }
  64.  
  65. DEFAULT    {
  66.    GetWord (Word);
  67.    Errors.MessageI ("illegal character", Errors.Error, Attribute.Position, Errors.String, ADR (Word));
  68. }
  69.  
  70. EOF     {
  71.    CASE yyStartState OF
  72.    | comment    : Error ("unclosed comment", Position);
  73.    | expr    ,
  74.      targetcode    : Error ("unclosed target code", Position);
  75.    | CStr1, CStr2,
  76.      Str1, Str2    : Error ("unclosed string", StringPos);
  77.    ELSE
  78.    END;
  79. }
  80.  
  81. DEFINE  letter  =   {A-Z a-z _}    .
  82.         digit   =   {0-9}    .
  83.     CmtCh   = - {*\t\n}    .
  84.     StrCh1    = - {'\t\n}    .
  85.     StrCh2    = - {"\t\n}    .
  86.     CStrCh1    = - {'\t\n\\}    .
  87.     CStrCh2    = - {"\t\n\\}    .
  88.     code    = - {\\\t\n{\}'"} .
  89.     anyExpr    = - {\\\t\n{\}'":\ a-zA-Z} .
  90.  
  91. START    comment, Str1, Str2, CStr1, CStr2, targetcode, expr
  92.  
  93. RULE
  94.  
  95. #targetcode#    "{"    : {
  96.                IF NestingLevel = 0 THEN
  97.                   MakeText (Attribute.TargetBlock.Text);
  98.                   AssignEmpty (TargetCode);
  99.                   Position := Attribute.Position;
  100.                ELSE
  101.                   GetWord (Word);
  102.                   Concatenate (TargetCode, Word);
  103.                END;
  104.                INC (NestingLevel);
  105.             }
  106.  
  107. #targetcode#    "}"    :- {
  108.                DEC (NestingLevel);
  109.                IF NestingLevel = 0 THEN
  110.                   yyStart (STD);
  111.                   Append (Attribute.TargetBlock.Text, TargetCode);
  112.                   Attribute.Position := Position;
  113.                   RETURN TargetBlock;
  114.                ELSE
  115.                   GetWord (Word);
  116.                   Concatenate (TargetCode, Word);
  117.                END;
  118.             }
  119.  
  120. #targetcode#    code +    :- {
  121.                IF NestingLevel > 0 THEN
  122.                   GetWord (Word);
  123.                   Concatenate (TargetCode, Word);
  124.                END;
  125.             }
  126.  
  127. #targetcode#    \t    :- {
  128.                IF NestingLevel > 0 THEN
  129.                   Strings.Append (TargetCode, 11C);
  130.                END;
  131.                yyTab;
  132.             }
  133.  
  134. #targetcode#    \n    :- {
  135.                IF NestingLevel > 0 THEN
  136.                   Append (Attribute.TargetBlock.Text, TargetCode);
  137.                   AssignEmpty (TargetCode);
  138.                END;
  139.                yyEol (0);
  140.             }
  141.  
  142. #targetcode#    \\ ANY    :- {
  143.                IF NestingLevel > 0 THEN
  144.                   GetWord (Word);
  145.                   Strings.Append (TargetCode, Char (Word, 2));
  146.                END;
  147.             }
  148.  
  149. #targetcode#    \\    :- {
  150.                IF NestingLevel > 0 THEN
  151.                   Strings.Append (TargetCode, '\');
  152.                END;
  153.             }
  154.  
  155. #STD, expr# "/*"    :  {yyStart (comment); Position := Attribute.Position;}
  156. #comment# "*/"        :- {yyPrevious;}
  157. #comment# "*" | CmtCh +    :- {}
  158.  
  159. #STD# \f | \r        :- {}
  160.  
  161. #STD# (digit + "." digit * | digit * "." digit +) ({Ee} {+\-} ? digit +) ? | digit +
  162.             :  {GetWord (Word);
  163.                         Attribute.Number.StringRef := PutString (Word);
  164.                 RETURN Number;}
  165.  
  166. #STD, expr, targetcode# ' :{GetWord (String);
  167.                 StringPos := Attribute.Position;
  168.                 IF IsElement (ORD ('c'), Options)
  169.                 THEN yyStart (CStr1);
  170.                 ELSE yyStart (Str1);
  171.                 END;}
  172.  
  173. #STD, expr, targetcode# \":{GetWord (String);
  174.                 StringPos := Attribute.Position;
  175.                 IF IsElement (ORD ('c'), Options)
  176.                 THEN yyStart (CStr2);
  177.                 ELSE yyStart (Str2);
  178.                 END;}
  179.  
  180. #Str1#    StrCh1 +    ,
  181. #Str2#    StrCh2 +    ,
  182. #CStr1#    CStrCh1 + | \\ ANY ? ,
  183. #CStr2#    CStrCh2 + | \\ ANY ? :- {GetWord (Word); Concatenate (String, Word);}
  184.  
  185. #CStr1#    \\ \n        ,
  186. #CStr2#    \\ \n        :- {GetWord (Word); Concatenate (String, Word); yyEol (0);}
  187.  
  188. #Str1, CStr1# '        ,
  189. #Str2, CStr2# \"    :- {Strings.Append (String, Char (String, 1));
  190.                 yyPrevious;
  191.                 IF yyStartState = targetcode THEN
  192.                    Concatenate (TargetCode, String);
  193.                 ELSE
  194.                    Attribute.String.StringRef := PutString (String);
  195.                    RETURN String;
  196.                 END;}
  197.  
  198. #Str1, Str2, CStr1, CStr2# \t :- {Strings.Append (String, 11C); yyTab;}
  199.  
  200. #Str1, Str2, CStr1, CStr2# \n :- {Error ("unclosed string", Attribute.Position);
  201.                 Strings.Append (String, Char (String, 1));
  202.                 yyEol (0); yyPrevious;
  203.                 IF yyStartState = targetcode THEN
  204.                    Concatenate (TargetCode, String);
  205.                 ELSE
  206.                    Attribute.String.StringRef := PutString (String);
  207.                    RETURN String;
  208.                 END;}
  209.  
  210. #STD# "::"        : {RETURN '::'            ;}
  211.  
  212. #STD# "{"        : {IF NestingLevel = 0 THEN Position := Attribute.Position; END;
  213.                yyStart (expr); INC (NestingLevel); RETURN '{';}
  214.  
  215. #expr# anyExpr *    : {GetWord (Word);
  216.                Attribute.TargetCode.StringRef := PutString (Word);
  217.                RETURN TargetCode        ;}
  218.  
  219. #expr# "{"        : {INC (NestingLevel);
  220.                GetWord (Word);
  221.                Attribute.TargetCode.StringRef := PutString (Word);
  222.                RETURN TargetCode        ;}
  223.  
  224. #expr# "}"        : {DEC (NestingLevel);
  225.                IF NestingLevel = 0 THEN
  226.                   yyStart (STD);
  227.                   RETURN '}';
  228.                ELSE
  229.                   GetWord (Word);
  230.                   Attribute.TargetCode.StringRef := PutString (Word);
  231.                   RETURN TargetCode;
  232.                END                ;}
  233.  
  234. #expr# ":"        : {GetWord (Word);
  235.                Attribute.TargetCode.StringRef := PutString (Word);
  236.                RETURN TargetCode        ;}
  237.  
  238. #expr# "::"        : {GetWord (Word);
  239.                Attribute.'::'.StringRef := PutString (Word);
  240.                RETURN '::'            ;}
  241.  
  242. #expr# " " +        : {GetWord (Word);
  243.                Attribute.WhiteSpace.StringRef := PutString (Word);
  244.                RETURN WhiteSpace        ;}
  245.  
  246. #expr# \n        : {GetWord (Word);
  247.                Attribute.WhiteSpace.StringRef := PutString (Word);
  248.                yyEol (0);
  249.                RETURN WhiteSpace        ;}
  250.  
  251. #expr# \t        : {GetWord (Word);
  252.                Attribute.WhiteSpace.StringRef := PutString (Word);
  253.                yyTab;
  254.                RETURN WhiteSpace        ;}
  255.  
  256. #expr# \\ ANY        : {GetWord (Word);
  257.                SubString (Word, 2, 2, String);
  258.                Attribute.TargetCode.StringRef := PutString (String);
  259.                RETURN TargetCode        ;}
  260.  
  261. #expr# \\        : {GetWord (Word);
  262.                Attribute.TargetCode.StringRef := PutString (Word);
  263.                RETURN TargetCode        ;}
  264.  
  265. #STD# BEGIN        : {yyStart (targetcode); RETURN 'BEGIN'    ;}
  266. #STD# CLOSE        : {yyStart (targetcode); RETURN 'CLOSE'    ;}
  267. #STD# EXPORT        : {yyStart (targetcode); RETURN 'EXPORT';}
  268. #STD# GLOBAL        : {yyStart (targetcode); RETURN 'GLOBAL';}
  269. #STD# IMPORT        : {yyStart (targetcode); RETURN 'IMPORT';}
  270. #STD# LOCAL        : {yyStart (targetcode); RETURN 'LOCAL'    ;}
  271.  
  272. #STD# 
  273.   "!"
  274. | "!="
  275. | "#"
  276. | "%"
  277. | "&"
  278. | "&&"
  279. | "*"
  280. | "+"
  281. | "-"
  282. | "/"
  283. | "<"
  284. | "<<"
  285. | "<="
  286. | "<>"
  287. | "="
  288. | "=="
  289. | ">"
  290. | ">="
  291. | ">>"
  292. | "|"
  293. | "||"
  294. | "~"
  295. | AND
  296. | DIV
  297. | IN
  298. | MOD
  299. | \NOT
  300. | OR
  301.             : {GetWord (Word);
  302.                        Attribute.Operator.Ident := MakeIdent (Word);
  303.                RETURN Operator        ;}
  304.  
  305. #STD# "++" | "--"    : {GetWord (Word);
  306.                        Attribute.IncOperator.Ident := MakeIdent (Word);
  307.                RETURN IncOperator        ;}
  308.  
  309. #STD# \\ - {\ \t\n} +    : {GetWord (Word);
  310.                SubString (Word, 2, Length (Word), String);
  311.                        Attribute.Operator.Ident := MakeIdent (String);
  312.                RETURN Operator        ;}
  313.  
  314. INSERT RULES #STD#
  315.  
  316. #STD# "..."        : {RETURN '..'            ;}
  317. #STD# ":-"        : {RETURN '?'            ;}
  318.  
  319. #STD, expr# letter (letter | digit) *
  320.             : {GetWord (Word);
  321.                        Attribute.Ident.Ident := MakeIdent (Word);
  322.                RETURN Ident            ;}
  323.